home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga News 95
/
Amiga News 95.iso
/
dpat
/
dpat96
/
klondike_adptools_v1.1
/
datas
/
english.lha
/
2-MakeGlobalPalette.adpro
< prev
next >
Wrap
Text File
|
1995-04-11
|
9KB
|
397 lines
/*
** MakeGlobalPalette.adpro
** This ARexx script for ADPro v2.5 or higher load some selected pictures
** (IFF ILBM 24Bits, 86x128) selected by user, render then in a big backdrop
** picture, and finally save the resultant palette.
**
** $VER: MakeGlobalPalette/English v1.1 (06.04.95) © Copyright Lejardinier Olivier - All rights reserverd
**
*/
ADDRESS "ADPro"
OPTIONS RESULTS
NL = '0A'X
FALSE = 0
TRUE = 1
/*
** Save the current environment.
*/
TempDefaults = "T:TempADProDefaults"
SAVE_DEFAULTS TempDefaults
/*
** Initializations.
*/
CLOSE_RENDER_SCREEN
CLEAR_RENDERED
CLEAR_RAW
PSTATUS "UNLOCKED"
ADPRO_TO_FRONT
MemoryError = "Perhaps not enought memory."
FileMemError = "Perhaps file corrupted or not enought memory."
DiskSpaceError = "Perhaps not enought disk space."
/*
** Get some cards files.
*/
Continue = FALSE
DO UNTIL ( Continue = TRUE )
GETFILES '"Select 4 or more cards files :"'
IF ( RC ~= 0 ) THEN
DO
OKAYN '"Error :"' '"You MUST select some cards files !"' '"Select|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
END
ELSE
DO
CardsFiles = ADPRO_RESULT
NbCards = WORDS( CardsFiles )
IF ( NbCards < 4 ) THEN
DO
OKAYN '"Error :"' '"You MUST select at least 4 cards files !"' '"Select|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
END
ELSE
Continue = TRUE
END
END
/*
** Create backdrop.
*/
Max = WORDS( CardsFiles ) % 4
Curr = Max
LOAD_TYPE "REPLACE"
Continue = FALSE
DO UNTIL (( Continue = TRUE ) | ( Curr = 0 ))
LOADER "BACKDROP" "XXX" "WIDTH" 4*88 "HEIGHT" Curr*130 "COLOR"
IF ( RC ~= 0) THEN
Curr = Curr - 1
ELSE
Continue = TRUE
END
IF ( Curr = 0 ) THEN
DO
Text = "Error : Not enought memory to compute global palette..."
OKAYN '"Error :"' '"'Text'"' '"Quit"'
CALL ForceExit
END
ELSE
DO
Continue0 = FALSE
Continue = FALSE
DO UNTIL ( Continue0 = TRUE )
DO UNTIL ( Continue = TRUE )
Text = "How many cards to render ? (" || Curr || "x4=" || Curr*4 || ") :"
GETNUMBER '"'Text'"' Curr 1 Max
IF ( RC ~= 0 ) THEN
DO
Text = "Ok to render" Curr || "x4=" || Curr*4 "cards ?"
OKAYN '"Confirm :"' '"'Text'"' '"Ok|Select|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
ELSE
IF ( RC = 1 ) THEN
Continue = TRUE
END
ELSE
DO
Curr = ADPRO_RESULT
Continue = TRUE
END
END
LOAD_TYPE "REPLACE"
LOADER "BACKDROP" "XXX" "WIDTH" 4*88 "HEIGHT" Curr*130 "COLOR"
IF ( RC ~= 0) THEN
DO
Text = "Unable to create backdrop." || NL || MemoryError
OKAYN '"Error :"' '"'Text'"' '"Retry|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
END
ELSE
DO
Max = Curr
Continue0 = TRUE
END
END
END
/*
** Compose all selected cards files.
*/
X = 0
Y = 0
NbCards = Max * 4
Index = 1
Counter = 0
LOAD_TYPE "COMPOSE"
DO WHILE ( Index <= NbCards )
Continue = FALSE
DO UNTIL ( Continue = TRUE )
Cardname = WORD( CardsFiles , Index )
LOADER "IFF" Cardname X+1 Y+1 100 -1 -1 -1
IF ( RC ~= 0 ) THEN
DO
Text = "Unable to load :" || NL || STRIP( Cardname , B , '"' ) || NL || FileMemError
OKAYN '"Error :"' '"'Text'"' '"Retry|Skip|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
ELSE
IF ( RC = 2 ) THEN
DO
Index = Index + 1
IF ( Index > NbCards ) THEN
DO
IF ( Counter = 0 ) THEN
DO
Text = "Unable to compute global palette : No pictures loaded !"
OKAYN '"Error :"' '"'Text'"' '"Quit"'
CALL ForceExit
END
ELSE
DO
Text = "No more cards files to load... " || NL || "Compute global palette with the" Counter "previous loaded pictures ?"
OKAYN '"Request :"' '"'Text'"' '"Yes|Quit"'
IF ( RC = 0 ) THEN
CALL ForceExit
END
END
END
END
ELSE
DO
Continue = TRUE
Index = Index + 1
Counter = Counter + 1
END
END
X = X + 88
IF ( X = 4*88) THEN
DO
X = 0
Y = Y + 130
END
END
/*
** Render all cards files.
*/
SET_RENDER_MODE Amiga 167940 4*88 Max*130 HAM8
DITHER 1
Continue = FALSE
DO UNTIL ( Continue = TRUE )
EXECUTE
IF ( RC ~= 0 ) THEN
DO
Text = "Unable to render final picture." || NL || MemoryError
OKAYN '"Error :"' '"'Text'"' '"Retry|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
END
ELSE
Continue = TRUE
END
/*
** Modify palette file.
*/
Text = "Do you want to use DEFAULT or CUSTOM background color ?"
OKAYN '"Request :"' '"'Text'"' '"Default|Abort|Custom"'
IF ( RC = 2 ) THEN
CALL ForceExit
ELSE
IF ( RC = 1 ) THEN
PPOKE 0 56 101 121
ELSE
DO
Text = "Select RED composante :"
GETNUMBER '"'Text'"' 56 0 255
IF ( RC ~= 0 ) THEN
Red0 = 56
ELSE
Red0 = ADPRO_RESULT
Text = "Select GREEN composante :"
GETNUMBER '"'Text'"' 101 0 255
IF ( RC ~= 0 ) THEN
Green0 = 101
ELSE
Green0 = ADPRO_RESULT
Text = "Select BLUE composante :"
GETNUMBER '"'Text'"' 121 0 255
IF ( RC ~= 0 ) THEN
Blue0 = 121
ELSE
Blue0 = ADPRO_RESULT
PPOKE 0 Red0 Green0 Blue0
END
PPOKE 1 255 0 0
PPOKE 2 255 255 255
PPOKE 3 0 0 0
PPOKE 20 255 0 0
PPOKE 24 255 0 0
/*
** Save palette file.
*/
DestDir = WORD( CardsFiles , 1 )
FirstChar = LEFT( DestDir , 1 )
IF ( (FirstChar = '"') | (FirstChar = '''') ) THEN
DestDir = STRIP( DestDir, "B" , FirstChar )
FNameSepPos = LASTPOS( '/' , DestDir )
IF (FNameSepPos = 0) THEN
FNameSepPos = LASTPOS( ':' , DestDir )
IF (FNameSepPos ~= 0) THEN
DO
Basename = RIGHT( DestDir , LENGTH( DestDir ) - FNameSepPos )
DestDir = LEFT( DestDir , FNameSepPos )
IF ( LASTPOS( '.' , Basename ) ~= 0 ) THEN
Basename = DELSTR( Basename , LASTPOS( '.' , Basename ) )
END
ELSE
DO
DestDir = ""
Basename = "Cards"
END
Palettename = Basename || ".Palette"
Continue = FALSE
DO UNTIL ( Continue = TRUE )
GETFILE '"Select palette filename :"' '"'DestDir'"' '"'Palettename'"'
IF ( RC ~= 0 ) THEN
DO
Text = "Use" Palettename "as palette filename ?"
OKAYN '"Confirm :"' '"'Text'"' '"Use|Select|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
ELSE
IF ( RC = 1 ) THEN
DO
Palettename = DestDir || Palettename
Continue = TRUE
END
END
ELSE
DO
Palettename = ADPRO_RESULT
Continue = TRUE
END
END
Continue = FALSE
DO UNTIL ( Continue = TRUE )
PSAVE Palettename
IF ( RC ~= 0 ) THEN
DO
Text = "Unable to save palette file :" || NL || STRIP( Palettename , B , '"' ) || NL || DiskSpaceError
OKAYN '"Error :"' '"'Text'"' '"Retry|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
END
ELSE
Continue = TRUE
END
/*
** Save preview.
*/
OKAYN '"Request :"' '"Do you want to save preview cards picture ?"' '"Save|Quit"'
IF ( RC = 1 ) THEN
DO
CLOSE_RENDER_SCREEN
CLEAR_RENDERED
PSTATUS "UNLOCKED"
EXECUTE
IF ( RC ~= 0 ) THEN
DO
Text = "Unable to render preview..."
OKAYN '"Error :"' '"'Text'"' '"Quit"'
CALL ForceExit
END
ELSE
DO
Previewname = Basename || "_Preview.HAM8"
Continue = FALSE
DO UNTIL ( Continue = TRUE )
GETFILE '"Select preview cards filename :"' '"'DestDir'"' '"'Previewname'"'
IF ( RC ~= 0 ) THEN
DO
Text = "Use" Previewname "as preview cards filename ?"
OKAYN '"Confirm :"' '"'Text'"' '"Use|Select|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
ELSE
IF ( RC = 1 ) THEN
DO
Previewname = DestDir || Previewname
Continue = TRUE
END
END
ELSE
DO
Previewname = ADPRO_RESULT
Continue = TRUE
END
END
Continue = FALSE
DO UNTIL ( Continue = TRUE)
SAVER "IFF" Previewname "IMAGE"
IF ( RC ~= 0 ) THEN
DO
Text = "Unable to save preview cards file :" || NL || STRIP( Previewname , B , '"' ) || NL || DiskSpaceError
OKAYN '"Error :"' '"'Text'"' '"Retry|Abort"'
IF ( RC = 0 ) THEN
CALL ForceExit
END
ELSE
Continue = TRUE
END
END
END
/*
** Quit.
*/
ForceExit:
CLOSE_RENDER_SCREEN
CLEAR_RENDERED
CLEAR_RAW
IF ( EXISTS( TempDefaults ) ) THEN
DO
LOAD_DEFAULTS TempDefaults
IF ( RC ~= 0 ) THEN
OKAY1 "Error restoring settings."
ADDRESS COMMAND "C:Delete >NIL: FILE" TempDefaults "QUIET"
END
EXIT 0
RETURN